home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0090_Wildcard unit.pas < prev   
Pascal/Delphi Source File  |  1995-02-28  |  6KB  |  217 lines
  1. program wildcards;
  2. {***************************************************************************=
  3. *
  4.  *  Ren=82 Schwietzke  Richard-Koenig-Str. 08  D-04916 Herzberg  GERMANY    =
  5.   *
  6.  *                                                                         =
  7.  *
  8.  *  Internet: rs@informatik.tu-cottbus.de                                  =
  9.  *
  10. =
  11.  ***************************************************************************=
  12. *
  13.  *  This is my implementation of a simple wildcard recognizer.             =
  14.  *
  15.  *  Try it !                                                               =
  16.  *
  17.  *  Please check the correctness, report all bugs and say your opinion.    =
  18.  *
  19.  *                                                                         =
  20.  *
  21.  *  written in Borland Pascal 7.0 with using of exit, break and continue   =
  22.  *
  23. =
  24.  ***************************************************************************=
  25. *
  26. }
  27. uses crt; {only for this demo}
  28. { *                : >= 0 letters
  29.   for example:
  30.    *A              : words with >= 1 letters and A at the end
  31.    A*A             : words with >= 2 letters and A at the begin and end=20
  32.    A*              : words with >= 1 letters and A at the begin
  33.  =20
  34.   ?                : one letter
  35.  
  36.   Combine it !
  37.   See the examples at the end.}
  38.  
  39. {********** this function returns true if input_word= wilds=
  40.  ****************}
  41. Function Wild(input_word,wilds:String;upcase_wish:boolean):Boolean;
  42.  
  43.  {looking for next *, returns position and string until position}
  44.  function search_next(var wilds:string):word;
  45.  var position,position2:word;
  46.  begin
  47.   position:=pos('*',wilds); {looks for *}
  48.  
  49.   if position<>0 then wilds:= copy(wilds,1,position-1);
  50.      {returns the string}
  51.  
  52.   search_next:= position;
  53.  end;
  54.  
  55.  {compares a string with '?' and another,
  56.   returns the position of helpwilds in input_word}
  57.  function find_part(helpwilds,input_word:string):word;
  58.  var q,q2,q3,between:word;
  59.      diff:integer;
  60.  begin
  61.   q:= pos('?',helpwilds);
  62.  
  63.   if q= 0 then
  64.    begin
  65.     {if no '?' in helpwilds}
  66.  
  67.     find_part:= pos(helpwilds,input_word);
  68.     exit;
  69.    end;
  70.  
  71.   {'?' in helpwilds}
  72.   diff:= length(input_word)-length(helpwilds);
  73.   if diff<0 then begin find_part:= 0;exit;end;
  74.   between:= 0;
  75.  
  76.   {now move helpwilds over input_word}
  77.   for q:= 0 to diff do
  78.    begin
  79.     for q2:= 1 to length(helpwilds) do
  80.      begin
  81.       if (input_word[q+q2]= helpwilds[q2]) or (helpwilds[q2]= '?') then
  82.        begin if q2= length(helpwilds) then begin find_part:= q+1;exit;end;end
  83.         else break;
  84.      end;
  85.    end;
  86.   find_part:= 0;
  87.  end;
  88. {************************** MAIN ******************************************}
  89. {                this is the mainpart of wild                              }
  90. var cwild,cinput_word:word;{counter for positions}
  91.     q,lengthhelpwilds:word;
  92.     maxinput_word,maxwilds:word;{length of input_word and wilds}
  93.     helpwilds:string;
  94. begin
  95.  wild:= false;
  96.  
  97.  {uncomment this for often use with 'wildcardless' wilds}
  98.  {if wilds= input_word then begin wild:= true;exit;end;}
  99.  
  100.  {delete '**', because '**'= '*'}
  101.  repeat
  102.   q:= pos('**',wilds);
  103.   if q<>0 then
  104.    wilds:= copy(wilds,1,q-1)+'*'+copy(wilds,q+2,255);
  105.  until q= 0;
  106.  
  107.  {for fast end, if wilds only '*'}
  108.  if wilds= '*' then begin wild:= true;exit;end;
  109.  
  110.  maxinput_word:= length(input_word);
  111.  maxwilds     := length(wilds);
  112.  
  113.  {upcase all letters}
  114.  if upcase_wish then
  115.   begin
  116.    for q:= 1 to maxinput_word do input_word[q]:= upcase(input_word[q]);
  117.    for q:= 1 to maxwilds do wilds[q]:= upcase(wilds[q]);
  118.   end;
  119.  
  120.  {set initialization}
  121.  cinput_word:= 1;cwild:= 1;
  122.  wild:= true;
  123.  
  124.  repeat
  125.   {equal letters}
  126.   if input_word[cinput_word]= wilds[cwild] then
  127.    begin
  128.     {goto next letter}
  129.     inc(cwild);
  130.     inc(cinput_word);
  131.     continue;
  132.    end;
  133.  
  134.   {equal to '?'}
  135.   if wilds[cwild]= '?' then
  136.    begin
  137.     {goto next letter}
  138.     inc(cwild);
  139.     inc(cinput_word);
  140.     continue;
  141.    end;
  142.  
  143.   {handling of '*'}
  144.   if wilds[cwild]= '*' then
  145.    begin
  146.     helpwilds:= copy(wilds,cwild+1,maxwilds);{takes the rest of wilds}
  147.  
  148.     q:= search_next(helpwilds);{search the next '*'}
  149.  
  150.     lengthhelpwilds:= length(helpwilds);
  151.  
  152.     if q= 0 then
  153.      begin
  154.       {no '*' in the rest}
  155.       {compare the ends}
  156.       if helpwilds= '' then exit;{'*' is the last letter}
  157.  
  158.       {check the rest for equal length and no '?'}
  159.       for q:= 0 to lengthhelpwilds-1 do
  160.        if (helpwilds[lengthhelpwilds-q]<>input_word[maxinput_word-q]) and
  161.           (helpwilds[lengthhelpwilds-q]<>'?') then
  162.          begin wild:= false;exit;end;
  163.       exit;
  164.      end;
  165.  
  166.     {handle all to the next '*'}
  167.     inc(cwild,1+lengthhelpwilds);
  168.     q:= find_part(helpwilds,copy(input_word,cinput_word,255));
  169.     if q= 0 then begin wild:= false;exit;end;
  170.     cinput_word:= q+lengthhelpwilds;
  171.     continue;
  172.    end;
  173.  
  174.   wild:= false;exit;
  175.  
  176.  until (cinput_word>maxinput_word) or (cwild>maxwilds);
  177.  {no completed evaluation}
  178.  if cinput_word<= maxinput_word then wild:= false;
  179.  if cwild<= maxwilds then wild:= false;
  180. end;
  181.  
  182. begin
  183.  clrscr;
  184.  {examples with the right result 'T' or 'F'}
  185.  writeln(wild('Gebauer','G?bauer',false),' T');
  186.  writeln(wild('Heiter','*r*s',false),' F');
  187.  writeln(wild('L=94ffler','*r*s',false),' F');
  188.  writeln(wild('Trinks','*r*s',false),' T');
  189.  writeln(wild('Schwietzke','*e*e*',false),' T');
  190.  writeln(wild('Endemann','*e*e*',false),' F');
  191.  writeln(wild('Schwietzke','Schwietzke',false),' T');
  192.  writeln(wild('Schwietzke','*',false),' T');
  193.  writeln(wild('Schwietzke','Schwi*',false),' T');
  194.  writeln(wild('Schwietzke','*tzke',false),' T');
  195.  
  196.  writeln(wild('Schwietzke','S?hwie*e',false),' T');
  197.  writeln(wild('Schwietzke','S*??*e',false),' T');
  198.  
  199.  writeln(wild('Schwietzke','S*e',false),' T');
  200.  writeln(wild('Schwietzke','*e',false),' T');
  201.  
  202.  writeln(wild('Schwietzke','S*k*',false),' T');
  203.  writeln(wild('Schwietzke','S??w??tzke',false),' T');
  204.  writeln(wild('Schwietzke','Sch*?t*ke',false),' T');
  205.  writeln(wild('Schwietzke','Sch*k',false),' F');
  206.  writeln(wild('Schwietzke','Sch*i?t*k?',false),' T');
  207.  
  208.  writeln(wild('Physik in =9Abersichten','?*',false),' T');
  209.  writeln(wild('Physik in =9Abersichten','P*??*en',false),' T');
  210.  
  211.  writeln(wild('Alle Physik in =9Abersichten Physik in Ablagen',
  212.               '*n Physik*',false),' T');
  213.  
  214.  {Thank's for testing and using.}
  215.  {Ren=82 Schwietzke 01-16-1995}
  216. end.
  217.